home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / html / cgi-bin / surf-lib-g.pl < prev    next >
Perl Script  |  1997-06-17  |  14KB  |  442 lines
  1. #!/usr/sbin/perl
  2. # $Id: surf-lib.pl,v 1.4 1997/01/28 22:31:44 beejay Exp $
  3. #
  4. # surf-lib.pl - perl library for Silicon Surf
  5. #
  6. #
  7. #
  8.  
  9. if (!defined &__SURF_LIB__) {
  10.     eval 'sub __SURF_LIB__ {1;}';
  11.  
  12. require('cgi-lib-g.pl') || die "can\'t load cgi-lib-g.pl: $!";
  13.  
  14. $ENV{'PATH'} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/bsd";
  15.  
  16. # Domains which have their own webmaster address.
  17. @webmaster_domains = ("ca","fr","it","uk");
  18.  
  19. $DocumentRoot = "/www/silicon_surf";
  20. # Get ServerRoot
  21. chop($hostname = `hostname`);
  22. $server_name = $ENV{'SERVER_NAME'} ? $ENV{'SERVER_NAME'} : $hostname;
  23. $server_port = $ENV{'SERVER_PORT'} ? $ENV{'SERVER_PORT'} : 80;
  24. ($addr=`grep server_name /etc/hosts`) =~ s/\s+.*$//;
  25. if ( -d "/usr/ns-home/httpd-${server_port}.$addr" ) {
  26.     $ServerRoot = "/usr/ns-home/httpd-${server_port}.$addr";
  27. } else {
  28.     $ServerRoot = "/usr/ns-home/httpd-$server_port";
  29. }
  30. # Get magnus.conf info
  31. open(MAGNUSCONF,"$ServerRoot/config/magnus.conf");
  32. while(<MAGNUSCONF>) {
  33.     chop;
  34.     s/\#.*$//;            # Remove comments
  35.     next if (/^\s*$/);        #  and strip blank lines
  36.  
  37.     ($option,$value) = split(/\s+/,$_,2);
  38.     next if ($option eq "Init"); # Skip Init lines
  39.     $MagnusConf{$option} = $value;
  40. }
  41. close(MAGNUSCONF);
  42.  
  43. # Get obj.conf info
  44. open(OBJCONF,"$ServerRoot/config/obj.conf");
  45. while(<OBJCONF>) {
  46.     chop;
  47.     if (/NameTrans/) {        # Name translation functions
  48.     if (/fn=\"document-root\"/ ) { # Document Root
  49.         /^.*root=\"([^\"]*)\".*$/;
  50.         $DocumentRoot = $1;
  51.     } elsif (/fn=\"unix-home\"/) {
  52.         ($from) = /from=\"([^\"]+)\"/;
  53.         ($dir) = /subdir=\"([^\"]+)\"/;
  54.         $NameTrans{$from} = $dir;
  55.         $NameTrans_type{$url} = "unix-home";
  56.     } elsif (/fn=\"home-page\"/) {
  57.         /^.*path=\"([^\"]*)\".*$/;
  58.         $HomePage = $1;
  59.     } elsif (/fn=\"pfx2dir\"/) { # Document alias
  60.         ($from) = /from=\"([^\"]+)\"/;
  61.         ($dir) = /dir=\"([^\"]+)\"/;
  62.         $NameTrans{$from} = $dir;
  63.         $NameTrans_type{$url} = "pfx2dir";
  64.     } elsif (/fn=\"redirect\"/) { # Server redirect
  65.         ($from) = /from=\"([^\"]+)\"/;
  66.         if (/url-prefix=/) {
  67.         ($url) = /url-prefix=\"([^\"]+)\"/;
  68.         $NameTrans_type{$url} = "redirect-prefix";
  69.         } else { 
  70.         ($url) = /url=\"([^\"]+)\"/;
  71.         $NameTrans_type{$url} = "redirect";
  72.         }
  73.         $NameTrans{$url} = $dir;
  74.     }
  75.     }
  76.     if (/<Object\s+.*ppath=\"([^\"]+)\"/) {
  77.     ($Object = $1) =~ s/\*/.*/g;    # Assign Object and make regexp
  78.     }
  79.     undef $Object if (/<\/Object>/);
  80.     $AuthTrans{$Object} = $_    if ($Object && /^AuthTrans/);
  81.     $PathCheck{$Object} = $_    if ($Object && /^PathCheck/);
  82. }
  83. close(OBJCONF);
  84.  
  85. ########################################
  86. # Check for authenticated path
  87. #    path    - path relative to $DocumentRoot
  88. # returns true if $path is part of an authenticated area
  89. #
  90. sub check_auth {
  91.     local($path) = @_;
  92.     local($AuthRealm);
  93.  
  94.     $path =~ s/^\///;        # Remove leading '/'
  95.     $path =~ s/^\.\///;        #  or './'
  96.     foreach $auth (keys %AuthTrans) {
  97.     $rauth = &clean_regexp($auth);
  98.     $rauth =~ s/\\\.\\\*/.*/g;    # Fix .* from config
  99.     if ("$DocumentRoot/$path" =~ /$rauth/ && !$ENV{'AUTHORIZED'}) {
  100.         ($AuthRealm = $PathCheck{$auth}) =~ s/^.*realm=\"([^\"]+)\".*$/$1/;
  101.         return($AuthRealm);
  102.     }
  103.     }
  104.     0;
  105. }
  106.  
  107. ########################################
  108. # Print standard document header
  109. #    title      - document title (will also appear as H1 text)
  110. #    titleimg   - if used, will display instead of H1 title (title will be
  111. #                 ALT= text)
  112. # Globals:
  113. #     $nomimeheader can be used to disable the Content-type header
  114. #    $nobug will turn off the SGI logo
  115. #    $ismap will set the header link to an imagemap
  116. #
  117. sub header {
  118.     local ($title,$titleimg) = @_;
  119.     
  120.     &PrintMimeHeader()    unless($nomimeheader);
  121.     print "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n" unless ($NoDoctype);
  122.     print <<EOFEOF;
  123. <HTML>
  124. <HEAD>
  125. <TITLE>$title</TITLE>
  126. <LINK REV="made" HREF="mailto:webmaster\@www.sgi.com">
  127. EOFEOF
  128. foreach (@InHead) {
  129.     print "$_\n";
  130. }
  131. print "</HEAD>\n";
  132.     
  133.     print "<BODY";
  134.     $attr{'bgcolor'} = "#FFFFFF"    unless($attr{'bgcolor'});
  135.     print " BGCOLOR=$attr{'bgcolor'} "    
  136.     if ($attr{'bgcolor'} || $attr{'background'} =~ /\#[0-9a-f]{6}/i);
  137.     print " BACKGROUND=$attr{'background'} "
  138.     if ($attr{'background'} =~ /\.gif$/i);
  139.     print " TEXT=$attr{'text'} "    if ($attr{'text'});
  140.     print " LINK=$attr{'link'} "    if ($attr{'link'});
  141.     print " VLINK=$attr{'vlink'} "    if ($attr{'vlink'});
  142.     print " ALINK=$attr{'alink'} "    if ($attr{'alink'});
  143.     print " $InBody "            if ($InBody);
  144.  
  145.     print ">\n";
  146.     print "<IMG SRC=\"/Images/CorpID.gif\" ALT=\"Silicon Graphics, Inc.\"><BR>\n"    unless($nobug);
  147.     print "<CENTER><P ALIGN=\"center\">\n"    if ($center);
  148.     print "<IMG SRC=\"$attr{'headimg'}\" ALT=\"\"><BR>\n"
  149.     if ($attr{'headimg'});
  150.     print "<H1>";
  151.     if ($titleimg) {
  152.     # &getlang is a SurfZone thingie....
  153.     print "<A HREF=\"$ismap\">"    if ($ismap);
  154.     if ($domain && defined &getlang) {
  155.         print "<IMG SRC=\"$titleimg\" ALT=\"";
  156.         print &getlang($title);
  157.     } else {
  158.         print "<IMG SRC=\"$titleimg\" ALT=\"$title\"";
  159.     }
  160.     print "\"";
  161.     print " ISMAP"        if ($ismap);
  162.     print " BORDER=\"$attr{'border'}\""    if (defined($attr{'border'}));
  163.     print " HEIGHT=\"$attr{'height'}\""    if (defined($attr{'height'}));
  164.     print " WIDTH=\"$attr{'width'}\""    if (defined($attr{'width'}));
  165.     print ">";
  166.     print "</A>"            if ($ismap);
  167.     } else {
  168.     if ($domain && defined &getlang) {
  169.         print &getlang($title);
  170.     } else {
  171.         print "$title";
  172.     }
  173.     }
  174.     print "</H1>\n";
  175.     print "</P></CENTER>\n"    if ($center);
  176. }
  177.  
  178. ########################################
  179. # Print standard document footer
  180. # The following hidden variables may be imbedded in the form:
  181. #   back_url            - URL back to form
  182. #   back_url_image      - Image for back link
  183. #   back_url_label      - Label for back link (will be ALT= text if image)
  184. #   return_url          - URL to return to document
  185. #   return_url_image    - Image for return link
  186. #   return_url_label    - Label for return link (will be ALT= text if image)
  187. # This will also print any icons for areas specified in PATH_INFO.
  188. sub footer {
  189. #    local($location) = @_;
  190.  
  191. #    $location = $ENV{'PATH_INFO'}    if (!$location);
  192. #    print "<HR SIZE=\"6\">\n";
  193.     print "<HR>\n";
  194.     print "<A HREF=\"/\"><IMG SRC=\"/Images/Icon/surf.gif\"></A>\n";
  195.     foreach $section (@sections) {
  196.     $name{$section} = $section unless $name{$section};
  197.         if ($icon_url{$section}) {
  198.             print "<A HREF=\"$root{$section}\"><IMG SRC=\"$icon_url{$section}\" ALT=\"\[$name{$section}\]\"></A>\n";
  199.         } elsif ($root{$section}) {
  200.             print "<A HREF=\"$root{$section}\">[$name{$section}\]</A>\n";
  201.         
  202.     }
  203.     }
  204.     if ($in{'back_url'}) {
  205.         if ($in{'back_url_image'}) {
  206.             print "<A HREF=\"$in{'back_url'}\"><IMG SRC=\"$in{'back_url_image'}\" ALT=\"$in{'back_url_label'}\"></A>\n";
  207.         } else {
  208.         $in{'back_url_label'} = "[Back]" if (! $in{'back_url_label'});
  209.             print "<A HREF=\"$in{'back_url'}\"><B>$in{'back_url_label'}</B></A>\n";
  210.         }
  211.     }
  212.     if ($in{'return_url'}) {
  213.         if ($in{'return_url_image'}) {
  214.             print "<A HREF=\"$in{'return_url'}\"><IMG SRC=\"$in{'return_url_image'}\" ALT=\"$in{'return_url_label'}\"></A>\n";
  215.         } else {
  216.         $in{'return_url_label'} = "[Return]" if (! $in{'return_url_label'});
  217.             print "<A HREF=\"$in{'return_url'}\"><B>$in{'return_url_label'}</B></A>\n";
  218.         }
  219.     }
  220.     print " <BR>\n";
  221.     # &getlang is a SurfZone thingie....
  222.     if ($domain && defined &getlang) {
  223.     print "<FONT SIZE=\"-1\">";
  224.     print &getlang("We welcome feedback and comments at");
  225.     print "\n";
  226.     } else {
  227.     print "<FONT SIZE=\"-1\">We welcome feedback and comments at\n";
  228.     }
  229.     if ($domain && grep(/^$domain$/,@webmaster_domains)) {
  230.     print "<A HREF=\"/cgi-bin/form_feedback/webmaster-$domain\@www.sgi.com?$domain\">webmaster-$domain\@www.sgi.com</A>. </FONT>\n";
  231.     } else {
  232.     print "<A HREF=\"/cgi-bin/form_feedback/webmaster\@www.sgi.com\">webmaster\@www.sgi.com</A>. </FONT>\n";
  233.     }
  234.     print "<P>\n";
  235.     
  236.     print "<FONT SIZE=\"-3\">";
  237.     if ($domain && defined &getlang) {
  238.     print &getlang("<A HREF=\"/Misc/sgi_info.html\">Copyright © 1995, 1996, Silicon Graphics, Inc.</A>  All Rights Reserved");
  239.     print &getlang("<A HREF=\"/Misc/external.list.html\">Trademark Information</A>");
  240.     } else {
  241.     print "<A HREF=\"/Misc/sgi_info.html\">Copyright © 1995, 1996, Silicon Graphics, Inc.</A> All Rights Reserved";
  242.     print "<A HREF=\"/Misc/external.list.html\">Trademark Information</A>";
  243.     }
  244.     print "</FONT>\n";
  245.     print "</BODY>\n";
  246.     print "</HTML>\n";
  247. }
  248.  
  249. ########################################
  250. # Escape all regexp characters for matching
  251. sub clean_regexp {
  252.     local($regex) = @_;
  253.     local($return);
  254.  
  255.     $regex =~ s/([\/()[\]*+|?.\{\}\\])/\\$1/g; # strip regexp
  256.     $regex;
  257. }
  258.  
  259. sub debug_print {
  260.     local($level,$message) = @_;
  261.  
  262.     return    unless (defined($debug));
  263.     return      if ($level > $debug);
  264.     if ($nocr && ($olevel == $level)) {
  265.         print STDERR "$message" if ($level <= $debug);
  266.     } else {
  267.         print STDERR "\n"       if ($nocr);
  268.         print STDERR "DEBUG:$level:$message";
  269.     }
  270.     $olevel = $level;
  271.     $nocr = $message !~ /\n/;
  272. }
  273.  
  274. ########################################
  275. # Standard error handling
  276. # input - array containing error message to print
  277. sub surf_error {
  278.     local(@error) = @_;
  279.     
  280.     &header("Error retrieving document!!","");
  281.     
  282.     foreach $line (@error) {
  283.     print "$line";
  284.     }
  285.     print "<P>\n";
  286.     
  287.     &footer();
  288.     
  289.     exit 1;
  290. }
  291.  
  292. ########################################
  293. # read_mimetypes - open and read the server mime.types file
  294. #    put the results into %mime_types_ext and %mime_types_icon by extension
  295. sub read_mimetypes {
  296.     local($type,$ext,$icon);
  297.  
  298.     open(MIME,"$ServerRoot/config/mime.types");
  299.     while (<MIME>) {
  300.     chop;
  301.     s/\#.*$//;
  302.     next if (/^$/);
  303.         ($type = $_) =~ s/^.*type=(\S+).*$/$1/;
  304.         ($exts = $_) =~ s/^.*exts=(\S+).*$/$1/;
  305.         ($icon = $_) =~ s/^.*icon=(\S+).*$/$1/;
  306.     undef($icon)    unless (/icon=/);
  307.         ($enc = $_) =~ s/^.*enc=(\S+).*$/$1/;
  308.     undef($enc)    unless (/enc=/);
  309.     foreach $ext (split(',',$exts)) {
  310.         if ($enc) {
  311.         $mime_type_enc{$ext} = $enc;
  312.         } else {
  313.         $mime_type_ext{$ext} = $type;
  314.         $mime_type_icon{$ext} = $icon;
  315.         }
  316.     }
  317.     }
  318.     close(MIME);
  319. }
  320.  
  321. sub PrintMimeHeader {
  322.     local($file) = @_;
  323.  
  324.     $file = "junk.html"    unless ($file); # Force HTML if no $file
  325.     &read_mimetypes unless($mime_type_ext{"html"});
  326.  
  327.     ($ext = $file) =~ s/^.*\.([^\.]+)$/$1/;
  328.     if ($mime_type_enc{$ext}) {
  329.         $enc = $ext;
  330.         ($ext = $file) =~ s/^.*\.([^\.]+)\.$enc$/$1/;
  331.     }
  332.  
  333.     if (!$server) {
  334.     $server = $server_name;
  335.     $server .= ":$server_port" if ($server_port && $server_port ne "80");
  336.     }
  337.  
  338.     # Send cookies if needed
  339.     foreach $cookie (@cookies) {
  340.     print "Set-Cookie:";
  341.     print " ${cookie}=$cookie_value{$cookie};" if (defined($cookie_value{$cookie}));
  342.     print " expires=$cookie_exp{$cookie};"       if (defined($cookie_exp{$cookie}));
  343.     print " path=$cookie_path{$cookie};"       if (defined($cookie_path{$cookie}));
  344.     print " domain=$cookie_domain{$cookie};"   if (defined($cookie_domain{$cookie}));
  345.     print " secure"                          if (defined($cookie_secure{$cookie}));
  346.     print "\n";
  347.     }
  348.  
  349.     # Send redirection if needed
  350.     if ($imagemap || $redirect) {
  351.     $file =~ s/^\///;
  352.     if ($redirect && $redirect =~ /https*:/) {
  353.         print "Location: $redirect\n";
  354.     } else {
  355.         print "Location: http://$server/$file\n";
  356.     }
  357.     }
  358.  
  359.     # Send content encoding and type
  360.     print "Content-encoding: $mime_type_enc{$enc}\n" if ($mime_type_enc{$enc});
  361.     if ($mime_type_ext{$ext}) {
  362.         print "Content-type: $mime_type_ext{$ext}\n";
  363.     } else {
  364.         print "Content-type: text/plain\n";
  365.     }
  366.     print "\n";
  367. }
  368.  
  369. ########################################
  370. # Print a string, wrapping it to fit given width
  371. #
  372. sub wrap_print {
  373.     local($handle,$string,$width) = @_;
  374.  
  375.     $pos = 0; $newend = $pos;
  376.     while($pos < length($string)) {
  377.     while($newend-$pos < $width) {
  378.         $end = $newend + 1;
  379.         $newend = index($string," ",$end);
  380.         $nl = index($string,"\n",$end);
  381.         if ($newend < 0) {
  382.         print $handle substr($string,$pos,length($string)-$pos);
  383.         print $handle "\n";
  384.         return;
  385.         }
  386.         if (($nl > 0 && $newend > $nl) && $nl-$pos < $width) {
  387.         $end = $nl + 1;
  388.         last;
  389.         }
  390.     }
  391.     print $handle substr($string,$pos,$end-$pos);
  392.     print $handle "\n";
  393.     $pos = $end if ($end);
  394.     }
  395. }
  396.  
  397. ########################################
  398. # Return a file name for a given document (based at DocumentRoot)
  399. # Returns both the "cleaned" filename, and the actual file pointed to
  400. # if this is a link.
  401. #
  402. sub getfilename {
  403.     local($baseurl) = @_;
  404.  
  405.     $baseurl =~ s/^\///;
  406.     $baseurl = "." unless($baseurl);  # Current directory if null
  407.  
  408.     # Convert to index.html/cgi if directory
  409.     if ($baseurl =~ /\/$/ || -d $baseurl) {
  410.         $baseurl .= "/"    if ($baseurl !~ /\/$/);
  411.         $baseurl .= "index.cgi" if (-f "$DocumentRoot/${baseurl}index.cgi" ||
  412.                     -l "$DocumentRoot/${baseurl}index.cgi");
  413.         $baseurl .= "index.html" if (-f "$DocumentRoot/${baseurl}index.html" ||
  414.                      -l "$DocumentRoot/${baseurl}index.html");
  415.     }
  416.     $baseurl =~ s/^\.//;           # Remove leading "." (top of tree)
  417.  
  418.     if (! -f "$DocumentRoot/$baseurl" && ! -l "$DocumentRoot/$baseurl") {
  419.         if (-d "$DocumentRoot/$baseurl") {
  420.             print STDERR "ERROR: $baseurl contains no index file\n" unless($quiet);
  421.         } else {
  422.             print STDERR "ERROR: $baseurl not found\n"     unless($quiet);
  423.             $baseurl = "";
  424.         }
  425.     }
  426.  
  427.     $lfile = "$DocumentRoot/$baseurl";
  428.     while (-l "$lfile") {
  429.     local($dirname,$basename);
  430.     ($dirname,$basename) = ($baseurl =~ (/^(.*)\/([^\/]*)$/));
  431.         $lfile = readlink($lfile);
  432.     if ($lfile !~ /^\//) {
  433.             ($lfile = "$DocumentRoot/$dirname/$lfile") =~ s/\/\//\//g;
  434.         }
  435.         return("","")    unless (-f "$lfile" || -l "$lfile");
  436.     }
  437.     ($baseurl,$lfile);
  438. }
  439.  
  440. }
  441. 1;
  442.